structure MipsFrame : FRAME =
struct
    structure A = Assem
    structure E = ErrorMsg
    structure M = Temp
    structure MB = M.Table
    structure R = Tree
    structure S = Symbol
    structure U = UnparseAbsyn

    type register = string

    val FP = M.newtemp ()
    val FPreg = ("$fp", FP)
    
    val RA = M.newtemp ()
    val RAreg = ("$ra", RA)

    val RV = M.newtemp ()
    val RVreg = ("$v0", RV)

    val SP = M.newtemp ()
    val SPreg = ("$sp", SP)
		
    val ZERO = M.newtemp ()
    val ZEROreg = ("$zero", ZERO)

    fun makeReg (s, n) = ("$" ^ s ^ (Int.toString n), M.newtemp ())

    fun makeRegs (s, n) = if (0=n)
			  then [makeReg (s, 0)]
			  else (makeReg (s, n))::makeRegs (s, n-1)

    fun regName (s, _) = s
    fun regTemp (_, t) = t

    val specialregs = [ ZEROreg, RAreg, SPreg ]

    val argregs = rev (makeRegs ("a", 3))
    val args = map regTemp argregs

    val calleesaveregs = rev (makeRegs ("s", 7))
    val calleesaves = map regTemp (FPreg :: calleesaveregs)

    val callersaveregs = RVreg :: (makeReg ("v", 1)) :: (rev (makeRegs ("t", 9)))
    val callersaves = map regTemp callersaveregs
		      
    val regs = (calleesaveregs @ callersaveregs @ argregs) (* @ specialregs) *)
    val registers = map regName regs

    val calldefs = [RA, RV]@callersaves

    val tempMap = foldr (fn ((s, m), t) => MB.enter (t, m, s))
			MB.empty
			(specialregs @ argregs @ callersaveregs @ calleesaveregs)
		  
    fun tempName t = case (MB.look (tempMap, t))
		      of NONE => M.makestring t
		       | SOME s => s

    datatype access = InFrame of int
		    | InReg of M.temp

    (*
     * The first 4 parameters are passed in registers, with remaining ones passed on the stack
     *
     * The stack layout is
     *
     *  outgoing args                                 incoming args    older frames ...
     *                 temps | ret | locals | static parm ... parm | ...
     *               ^                      ^ 
     *              SP                     FP
     *  ... lower addresses ...................................... higher addresses ...
     *)

    type frame = { name : M.label,
		   formals : access list,
		   sp : int ref }

    val wordSize = 4

    fun newFrame {name, formals} = let val firstIncomingOffset = 0
				       fun placeFormal (_,     (n, [],          formals)) = (n+wordSize, [], (InFrame n)::formals)
					 | placeFormal (true,  (n, rs,          formals)) = (n+wordSize, rs, (InFrame n)::formals)
					 | placeFormal (false, (n, ((_,r)::rs), formals)) = (n,          rs, (InReg r)  ::formals)
				   in let val (_, _, formals) = foldr placeFormal (firstIncomingOffset, argregs, []) formals
				      in {name = name, formals = formals, sp = ref 0}
				      end
				   end
				   
    fun formals {name, formals=formals, sp} = formals
	
    fun name {name=name, formals, sp} = name
	
    fun postdec r = let val n = !r
		    in ( r := n - wordSize
		       ; n )
		    end
		    
    fun allocLocal {name, formals, sp=sp} true = InFrame (postdec sp)
      | allocLocal _ false = InReg (M.newtemp ())
			     
    fun externalCall (s, args) = R.CALL (R.NAME (M.namedlabel ("_" ^ s)),
					 args)

    (* yields an R.MEM or R.TEMP which can be used as an l-value or an r-value *)
    fun exp (InFrame k) fp = R.MEM (R.BINOP (R.PLUS, fp, (R.CONST k)))
      | exp (InReg r) _ = R.TEMP r

    fun staticLink {name,formals=[],sp} = E.impossible "NO STATIC LINK"
      | staticLink {name,formals=(sl::realFormals),sp} = sl


    fun procEntryExit1 (frame, stm) = stm (* dummy as on p.170 *)

    fun procEntryExit2 (frame, body) = (A.OPER { assem = "#SRC\n",
						 src=[],
						 dst=[ZERO, RA, SP, FP]@callersaves,
						 jump=NONE })
				       :: body
				       @ [A.OPER { assem = "#SINK\n", (* cf. pp. 208--209 *)
						   src=[ZERO, RA, SP, FP]@calleesaves,
						   dst=[],
						   jump=SOME[] }]

    fun procEntryExit3 ({name, formals, sp}, body) = (* dummy on p.209 *)
	{ prolog = "#PROCEDURE " ^ S.name name ^ "\n",
	  body=body,
	  epilog = "#END " ^ S.name name ^ "\n" }
	
    fun string (l, s) = (S.name l) ^ ": .asciiz " ^ "\"" ^ (String.toCString s) ^ "\"" ^ "\n"

    fun formalString (InFrame n) = (Int.toString n) ^ "(fp)"
      | formalString (InReg t)   = M.makestring t

    datatype frag = PROC of {body : Tree.stm, frame : frame }
		  | STRING of M.label * string

    fun showRegs stream = (app (fn regs => TextIO.output (stream, "#REGS: " ^ U.commaSep (map (fn (r, t) => (r ^ "==" ^ (M.makestring t))) regs) ^ "\n"))
			       [specialregs, argregs, calleesaveregs, callersaveregs])
end
